home *** CD-ROM | disk | FTP | other *** search
-
- (*----------------------------------------------------------------------*)
- (* Send_Xmodem_File --- Upload file using XMODEM *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Send_Xmodem_File( Use_CRC : BOOLEAN );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Send_Xmodem_File *)
- (* *)
- (* Purpose: Uploads file to remote host using XMODEM protocol. *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Send_Xmodem_File( Use_CRC ); *)
- (* *)
- (* Use_CRC --- TRUE to use Cyclic redundancy check version *)
- (* of XMODEM; FALSE to use Checksum version. *)
- (* *)
- (* Remarks: *)
- (* *)
- (* The file's existence should have been already checked *)
- (* prior to calling this routine. *)
- (* *)
- (* The transmission parameters are automatically set to: *)
- (* *)
- (* Current baud rate, 8 bits, No parity, 1 stop *)
- (* *)
- (* and then they are automatically restored to the previous *)
- (* values when the transfer is complete. *)
- (* *)
- (* Calls: KeyPressed *)
- (* Async_Send *)
- (* Async_Receive *)
- (* Compute_Crc *)
- (* Draw_Menu_Frame *)
- (* Save_Screen *)
- (* Restore_Screen *)
- (* Async_Open *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- (* If this threshhold value x number *)
- (* of bad blocks > number of good *)
- (* blocks, reduce block size to 128 *)
- CONST
- Bad_Threshhold = 6;
-
- VAR
- Xfile_Byte : FILE OF BYTE (* Same as transfer file, file size *);
- XFile_Handle : INTEGER (* File handle for file to transfer *);
- I : INTEGER (* Loop index *);
- Tries : INTEGER (* # of tries sending current sector *);
- Checksum : INTEGER (* Sector checksum *);
- Crc : INTEGER (* Cyclic redundancy check *);
- Ch : INTEGER (* Character received from COM port *);
- Sector_Length : INTEGER (* # chars to send *);
- Kbd_Ch : CHAR (* Absorbs keyboard characters *);
- Send_Errors : INTEGER (* Counts transfer errors *);
- Blocks_To_Send: INTEGER (* Number of blocks to send *);
- Sector_Count : INTEGER (* Sector count -- no wrap at 255 *);
- Transfer_Time : INTEGER (* Transfer time in seconds *);
- Starting_Time : INTEGER (* Starting transfer time *);
- Trans_Hours : INTEGER (* Transfer time -- hours component *);
- Trans_Minutes : INTEGER (* Transfer time -- mins. component *);
- Trans_Seconds : INTEGER (* Transfer time -- secs. component *);
- S_Hours : STRING[2] (* Hours in character form *);
- S_Minutes : STRING[2] (* Minutes in character form *);
- S_Seconds : STRING[2] (* Seconds in character form *);
- Time_To_Send : REAL (* Time in seconds to transfer file *);
- Time_Per_Blk : REAL (* Time in seconds to transfer block *);
- Effective_Rate: REAL (* Effective baud rate of transfer *);
- Start_Time : REAL (* Starting time of transfer *);
- End_Time : REAL (* Ending time of transfer *);
- NRead : INTEGER (* Records actually read from file *);
- EOF_Xfile : BOOLEAN (* EOF encountered on file to send *);
- Tname : STRING[20] (* Transfer type *);
- Sector_Size1 : INTEGER (* Sector size + 1 *);
- Sector_Size2 : INTEGER (* Sector size + 2 *);
- Alt_S_Found : BOOLEAN (* TRUE if alt_s entered *);
- Max_Tries : INTEGER (* Max. number of retries *);
- R_Sector_Size : REAL (* Sector size as reals *);
- Header_Ch : CHAR (* Block header character *);
- New_Header_Ch : CHAR (* Revised block header if downshift *);
- Bad_Sectors : INTEGER (* Count of bad sectors *);
- Good_Sectors : INTEGER (* Count of good sectors *);
- ITime : INTEGER (* Counter for wait loops *);
-
- (*----------------------------------------------------------------------*)
- (* Update_Xmodem_Send_Display --- Update display of Xmodem sending *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Update_Xmodem_Send_Display;
-
- BEGIN (* Update_Xmodem_Send_Display *)
-
- GoToXY( 26 , 4 );
- WRITE( Sector_Count );
- GoToXY( 26 , 5 );
- WRITE( Send_Errors );
- GoToXY( 26 , 6 );
- WRITE( TimeString( Time_To_Send ) );
-
- END (* Update_Xmodem_Send_Display *);
-
- (*----------------------------------------------------------------------*)
- (* Display_Send_Error --- Display XMODEM sending error *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Display_Send_Error( Err_Text: AnyStr; Display_Block: BOOLEAN );
-
- BEGIN (* Display_Send_Error *)
-
- GoToXY( 26 , 8 );
-
- WRITE(Err_Text);
-
- IF Display_Block THEN
- WRITE( ' at/before block ', MAX( Sector_Count - 1 , 0 ) );
-
- ClrEol;
-
- END (* Display_Send_Error *);
-
- (*----------------------------------------------------------------------*)
- (* Check_Keyboard --- Check for keyboard entry *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Check_Keyboard;
-
- BEGIN (* Check_Keyboard *)
-
- IF KeyPressed THEN
- BEGIN
- READ( Kbd, Kbd_Ch );
- IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN
- BEGIN
- READ( Kbd , Kbd_Ch );
- Alt_S_Found := ( ORD( Kbd_Ch ) = Alt_S );
- Stop_Send := Stop_Send OR Alt_S_Found;
- END;
- END;
-
- END (* Check_Keyboard *);
-
- (*----------------------------------------------------------------------*)
- (* Xmodem_Wait_For_Ch --- wait 10 seconds for character to appear *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Xmodem_Wait_For_Ch( VAR Ch: INTEGER );
-
- BEGIN (* Xmodem_Wait_For_Ch *)
-
- ITime := 0;
-
- REPEAT
- ITime := ITime + 1;
- Async_Receive_With_Timeout( One_Second , Ch );
- Check_KeyBoard;
- UNTIL ( Ch <> TimeOut ) OR ( ITime >= Ten_Seconds ) OR Stop_Send;
-
- END (* Xmodem_Wait_For_Ch *);
-
- (*----------------------------------------------------------------------*)
- (* Send_Xmodem_Block --- send out Xmodem block *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Send_Xmodem_Block;
-
- VAR
- I : INTEGER;
- ITime : INTEGER;
-
- BEGIN (* Send_Xmodem_Block *)
- (* Reset error count to zero *)
- Tries := 0;
-
- REPEAT
- (* Send 1st char of block *)
- Async_Send( Header_Ch );
- (* Send block number and complement *)
-
- Async_Send( CHR( Sector_Number ) );
- Async_Send( CHR( 255 - Sector_Number ) );
-
- (* Transmit Sector Data *)
-
- FOR I := 1 TO Sector_Length DO
- Async_Send( CHR( Sector_Data[ I ] ) );
-
- (* Purge receive buffer *)
- Async_Purge_Buffer;
- (* Increment count of tries to send *)
- (* for this sector. *)
- Tries := Tries + 1;
- (* Pick up a character -- should be ACK *)
- Xmodem_Wait_For_Ch( Ch );
- (* If CAN, insist on another *)
- IF Ch = CAN THEN
- Xmodem_Wait_For_Ch( Ch );
-
- IF Ch <> ACK THEN
- BEGIN
- Display_Send_Error('No ACK', TRUE);
- Send_Errors := Send_Errors + 1;
- END;
- (* Update display *)
- Update_Xmodem_Send_Display;
-
- UNTIL ( Ch = ACK ) OR
- ( Ch = CAN ) OR
- ( Tries > Max_Tries ) OR
- ( Stop_Send );
-
- END (* Send_Xmodem_Block *);
-
- (*----------------------------------------------------------------------*)
- (* Send_Telink_Header --- send out special block 0 for Telink *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Send_Telink_Header;
-
- BEGIN (* Send_Telink_Header *)
- (* Always send TELINK in Checksum mode *)
- Max_Tries := 3;
- I := Sector_Length;
- Sector_Length := 129;
- Header_Ch := CHR( SYN );
-
- Send_Xmodem_Block;
-
- Sector_Length := I;
- Max_Tries := 10;
-
- If ( Ch = ACK ) THEN
- BEGIN
- GoToXY( 26 , 8 );
- WRITE('Telink header accepted.');
- ClrEol;
- END
- ELSE
- BEGIN
- GoToXY( 26 , 8 );
- WRITE('Telink header not accepted.');
- ClrEol;
- END
-
- END (* Send_Telink_Header *);
-
- (*----------------------------------------------------------------------*)
- (* Send_Ymodem_Header --- send out special block 0 for Ymodem *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Send_Ymodem_Header;
-
- BEGIN (* Send_Ymodem_Header *)
- (* Always send short block 0 *)
- Max_Tries := 3;
- I := Sector_Length;
- Sector_Length := 130;
- Header_Ch := CHR( SOH );
-
- Send_Xmodem_Block;
-
- Sector_Length := I;
- Max_Tries := 10;
-
- If ( Ch = ACK ) THEN
- BEGIN
- GoToXY( 26 , 8 );
- WRITE('Ymodem header accepted.');
- ClrEol;
- END
- ELSE
- BEGIN
- GoToXY( 26 , 8 );
- WRITE('Ymodem header not accepted.');
- ClrEol;
- END
-
- END (* Send_Ymodem_Header *);
-
- (*----------------------------------------------------------------------*)
- (* Cancel_Transfer --- Cancel upload *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Cancel_Transfer;
-
- BEGIN (* Cancel_Transfer *)
- (* Purge reception *)
- Async_Purge_Buffer;
- (* Send five cancels, then five *)
- (* backspaces. *)
- Async_Send( CHR( CAN ) );
- Async_Send( CHR( CAN ) );
- Async_Send( CHR( CAN ) );
- Async_Send( CHR( CAN ) );
- Async_Send( CHR( CAN ) );
-
- Async_Send( CHR( BS ) );
- Async_Send( CHR( BS ) );
- Async_Send( CHR( BS ) );
- Async_Send( CHR( BS ) );
- Async_Send( CHR( BS ) );
-
- END (* Cancel_Transfer *);
-
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Send_Xmodem_File *)
- (* Open display window for transfer *)
- Save_Screen( Saved_Screen );
-
- CASE Transfer_Protocol OF
- Xmodem_Chk : Tname := 'Xmodem (Checksum)';
- Xmodem_Crc : Tname := 'Xmodem (CRC)';
- Telink : Tname := 'Telink';
- Modem7_Chk : Tname := 'Modem7 (Checksum)';
- Modem7_CRC : Tname := 'Modem7 (CRC)';
- Ymodem : Tname := 'Ymodem';
- Ymodem_Batch : Tname := 'Ymodem Batch';
- END (* CASE *);
-
- Draw_Menu_Frame( 15, 10, 78, 19, Menu_Frame_Color,
- Menu_Text_Color,
- 'Send file ' + FileName + ' using ' + Tname );
-
- (* Headings for status information *)
- Window( 16, 11, 77, 18 );
-
- ASSIGN( Xfile_Byte , FileName );
- (*$I-*)
- RESET ( Xfile_Byte );
- (*$I+*)
-
- IF ( Int24Result <> 0 ) THEN
- BEGIN
- WRITE('Cannot open file to send, transfer cancelled.');
- Cancel_Transfer;
- DELAY( One_Second_Delay );
- Restore_Screen( Saved_Screen );
- Reset_Global_Colors;
- EXIT;
- END;
- (* Determine sector size *)
-
- IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN
- Sector_Size := 1024
- ELSE
- Sector_Size := 128;
-
- Sector_Size1 := Sector_Size + 1;
- Sector_Size2 := Sector_Size + 2;
-
- IF Use_Crc THEN
- Sector_Length := Sector_Size2
- ELSE
- Sector_Length := Sector_Size1;
-
- (* Number of retries of bad block *)
- Max_Tries := 20;
- (* Figure approx. time for upload *)
-
- Blocks_To_Send := ROUND( ( LongFileSize( Xfile_Byte ) / Sector_Size ) + 0.49 );
- Time_To_Send := Blocks_To_Send * ( Sector_Size DIV 128 ) *
- ( Trans_Time_Val / Baud_Rate );
- Time_Per_Blk := Time_To_Send / Blocks_To_Send;
-
- (*$I-*)
- CLOSE ( Xfile_Byte );
- (*$I+*)
-
- I := Int24Result;
- (* Headings for status information *)
-
- WRITELN(' Blocks to send : ', Blocks_To_Send);
- WRITELN(' Approx. transfer time : ', TimeString( Time_To_Send ) );
- WRITELN(' ');
- WRITELN(' Sending block : ');
- WRITELN(' Errors : ');
- WRITELN(' Time remaining : ', TimeString( Time_To_Send ) );
- WRITELN(' ');
- WRITE (' Last status message : ');
-
- (* Open file to send *)
-
- I := Open_File_Handle( FileName, Access_Read_Mode, XFile_Handle );
-
- IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN
- BEGIN
- WRITE('Cannot open file to send, transfer cancelled.');
- Cancel_Transfer;
- DELAY( One_Second_Delay );
- Restore_Screen( Saved_Screen );
- Reset_Global_Colors;
- EXIT;
- END;
-
- (* Sector #s start at 1, wrap at 255 *)
- Sector_Number := 0;
- Sector_Count := 0;
- (* No errors yet *)
- Send_Errors := 0;
- (* Set TRUE if errors halt transfer *)
- Stop_Send := FALSE;
- (* Starting time for transfer *)
- Start_Time := TimeOfDay;
- (* Set EOF on Xfile to FALSE *)
- EOF_Xfile := FALSE;
- (* Set Alt_S encountered off *)
- Alt_S_Found := FALSE;
- (* No retries yet *)
- Tries := 0;
- (* Get initial character *)
- GoToXY( 26 , 8 );
- WRITE('Waiting for NAK/C --- ');
- ClrEol;
- (* Purge receive buffer *)
- Async_Purge_Buffer;
- (* Look for NAK or C *)
- REPEAT
-
- Xmodem_Wait_For_Ch( Ch );
-
- (* If CAN, insist on another *)
- IF Ch = CAN THEN
- Xmodem_Wait_For_Ch( Ch );
-
- Tries := Tries + 1;
-
- Check_KeyBoard;
-
- Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
-
- UNTIL ( Tries > Max_Tries ) OR
- ( Ch = NAK ) OR
- ( Ch = ORD( 'C' ) ) OR
- ( Ch = TimeOut ) OR
- ( Ch = CAN ) OR
- Stop_Send;
-
- IF ( Ch = TimeOut ) OR
- ( Tries > Max_Tries ) OR
- ( Ch = CAN ) THEN
- BEGIN
- GoToXY( 26 , 51 );
- WRITE('Not Received ');
- ClrEol;
- Stop_Send := TRUE;
- END
- ELSE IF ( Ch = NAK ) THEN
- Use_Crc := FALSE
- ELSE IF ( Ch = ORD( 'C' ) ) THEN
- Use_Crc := TRUE;
- (* Indicate OK reception *)
- IF ( NOT Stop_Send ) THEN
- BEGIN
-
- GoToXY( 26 , 51 );
- WRITE('Received ');
- ClrEol;
- (* Set header character *)
-
- IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN
- Header_Ch := CHR( STX )
- ELSE
- Header_Ch := CHR( SOH );
-
- New_Header_Ch := Header_Ch;
-
- (* If Telink or Ymodem, send the *)
- (* special initial sector, already *)
- (* prepared in Send_Modem7_File or *)
- (* Send_Ymodem_File *)
-
- IF Transfer_Protocol = Ymodem_Batch THEN
- Send_Ymodem_Header
- ELSE IF Transfer_Protocol = Telink THEN
- Send_Telink_Header;
-
- END;
- (* Begin loop over blocks in file *)
- REPEAT
- (* See if Alt-S hit, ending transfer *)
- Check_Keyboard;
-
- Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
-
- IF ( NOT Stop_Send ) THEN
- BEGIN (* Send the next sector *)
-
- (* Set block header character *)
-
- Header_Ch := New_Header_Ch;
-
- (* Read Sector_size chars from file *)
- (* to be sent. *)
- NRead := Sector_Size;
-
- I := Read_File_Handle( XFile_Handle, Sector_Data, NRead );
-
- (* Check for error *)
-
- IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN
- BEGIN
- Display_Send_Error('Cannot read data from file', TRUE);
- Stop_Send := TRUE;
- END
- (* If no chars. read, then EOF *)
-
- ELSE IF NRead <= 0 THEN
- EOF_Xfile := TRUE
- ELSE
- BEGIN (* NOT Eof *)
-
- (* Compute Checksum or Crc *)
- IF Use_Crc THEN
- BEGIN (* Use CRC *)
-
- Sector_Data[ Sector_Size1 ] := 0;
- Sector_Data[ Sector_Size2 ] := 0;
-
- Crc := 0;
-
- FOR I := 1 TO Sector_Size2 DO
- Crc := Update_Crc( Crc , Sector_Data[I] );
-
- Sector_Data[ Sector_Size1 ] := HI( Crc );
- Sector_Data[ Sector_Size2 ] := LO( Crc );
-
- END (* Use CRC *)
- ELSE
- BEGIN (* Use Checksum *)
-
- Checksum := 0;
-
- FOR I := 1 TO Sector_Size DO
- Checksum := ( Checksum + Sector_Data[ I ] ) MOD 256;
-
- Sector_Data[ Sector_Size1 ] := Checksum;
-
- END (* Use Checksum *);
-
- (* Increment sector number *)
-
- Sector_Number := Sector_Number + 1;
- Sector_Count := Sector_Count + 1;
-
- (* Send the block *)
- Send_Xmodem_Block;
-
- (* Update transmit time and counts *)
- (* of good/bad sectors; also shift *)
- (* to 128 byte sectors in Ymodem *)
- (* if ratio of bad/good > 1/6. *)
-
- IF Ch = ACK THEN
- BEGIN
- Time_To_Send := Time_To_Send - Time_Per_Blk;
- IF Time_To_Send < 0.0 THEN Time_To_Send := 0.0;
- Good_Sectors := Good_Sectors + 1;
- END
- ELSE
- BEGIN
- Bad_Sectors := Bad_Sectors + 1;
- IF ( Bad_Threshhold * Bad_Sectors > Good_Sectors ) THEN
- BEGIN
-
- New_Header_Ch := CHR( SOH );
-
- Sector_Size := 128;
-
- Sector_Size1 := Sector_Size + 1;
- Sector_Size2 := Sector_Size + 2;
-
- IF Use_Crc THEN
- Sector_Length := Sector_Size2
- ELSE
- Sector_Length := Sector_Size1;
-
- END;
- END;
-
- END (* Not EOF *)
-
- END (* Send Next Sector *);
-
- UNTIL ( EOF_Xfile ) OR ( Tries = Max_Tries ) OR ( Ch = CAN ) OR
- ( Stop_Send );
- (* Send CANs to host to cancel *)
- (* transfer *)
- IF Stop_Send THEN
- IF Async_Carrier_Detect THEN
- Cancel_Transfer;
-
- IF Tries >= Max_Tries THEN (* We failed to send a sector correctly *)
- Display_Send_Error('No ACK ever received.' , FALSE)
- ELSE IF ( Ch = CAN ) THEN (* Receiver cancelled transmission *)
- Display_Send_Error('Receiver cancelled transmission.',FALSE)
- ELSE IF Alt_S_Found THEN (* User cancelled transmission *)
- Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE)
- ELSE IF ( NOT Stop_Send ) THEN (* We sent everything, try sending EOT *)
- BEGIN
-
- GoToXY( 26 , 8 );
- WRITE('Waiting for ACK of EOT');
- ClrEol;
-
- Tries := 0;
-
- REPEAT
-
- Async_Send( CHR( EOT ) );
-
- Tries := Tries + 1;
-
- Xmodem_Wait_For_Ch( Ch );
-
- IF Ch = CAN THEN
- Xmodem_Wait_For_Ch( Ch );
-
- Update_Xmodem_Send_Display;
-
- UNTIL ( Ch = ACK ) OR
- ( Tries = Max_Tries ) OR
- ( Ch = CAN ) OR
- Stop_Send;
-
- IF Tries = Max_Tries THEN
- Display_Send_Error('No ACK on EOT (end of transmission)', FALSE)
- ELSE IF ( Ch = CAN ) THEN
- Display_Send_Error('Receiver cancelled transmission.' , FALSE)
- ELSE IF ( Alt_S_Found OR Stop_Send ) THEN
- Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE)
- ELSE
- BEGIN
-
- GoToXY( 26 , 8 );
- WRITE('EOT acknowledged, transfer complete.');
- ClrEol;
-
- End_Time := TimeOfDay;
- R_Sector_Size := Sector_Size;
-
- IF End_Time > Start_Time THEN
- BEGIN
- Effective_Rate := ( Blocks_To_Send * R_Sector_Size ) /
- ( End_Time - Start_Time );
- DELAY( One_Second_Delay );
- GoToXY( 26 , 8 );
- WRITE('Transfer rate was ',Effective_Rate:6:1,' CPS');
- ClrEol;
- END;
-
- Writelne( ' Sent file ' + FileName, FALSE );
-
- END;
-
- END;
-
- IF Stop_Send THEN
- IF Async_Carrier_Drop THEN
- Display_Send_Error('Carrier dropped.' , FALSE );
-
- (* Close transferred file *)
-
- I := Close_File_Handle( XFile_Handle );
- I := Int24Result;
-
- DELAY( Two_Second_Delay );
- (* Remove XMODEM window *)
- Restore_Screen( Saved_Screen );
-
- Reset_Global_Colors;
-
- END (* Send_Xmodem_File *);